perm filename MOKU.VLI[VLI,LSP] blob
sn#382033 filedate 1978-09-08 generic text, type C, neo UTF8
COMMENT ā VALID 00007 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 Algorithme de MINIMAX-ALPHA-BETA:
C00011 00003 TOP-LEVEL: fonctions JOUER, JEU1 et JEU2.
C00017 00004 Coup de la machine: fonction JEU2.
C00020 00005 (de execoup ()
C00032 00006
C00035 00007 (setq lcpforce nil)
C00041 ENDMK
Cā;
;Algorithme de MINIMAX-ALPHA-BETA:
exploration de l'arbre: fonction SEARCH.;
(status 2 27)
(setq oldvcp -30000)
(setq valcp 0)
(de search (profo maxmin alpha beta first)
(cond (gagne (setq gagne nil
pgagn nil
valcp 10000))
(coupforce
(push i j mind oldvcp)
(setq oldvcp alpha
mind coupforce
i cpfi
j cpfj)
(coup)
(setq coupforce nil)
(if first
(setq meili i
meilj j
meilleurcoup mind)
(search (sub1 profo)
(not maxmin)
(minus beta)
(minus oldvcp)))
(restit)
(setq valcp (minus valcp)
oldvcp (pop)
mind (pop)
j (pop)
i (pop)))
(t (push lcp oldvcp 1cl1 1cl2 pt2
cptcoups limit i j mind)
(setq oldvcp alpha
1cl1 cl1
1cl2 cl2
lcp (if lcpforce
(cons (cons mind1 (cons mind2
(if (eq lcpforce 3) (cons mind3))))
(setq lcpforce nil))
(cpsplaus))
pt2 (cdar lcp)
cptcoups 0
limit (if first 9 (breadth (plus profo 2))))
(escape out
(while lcp
(setq mind (or (suivant) (out))
i (rem mind 21)
j (quo mind 21))
(if (eq cptcoups limit) (setq lcp nil
cptcoups (add1 cptcoups))
(incr cptcoups))
(coup)
(if (lezp profo) (setq valcp (evalue))
(search (sub1 profo)
(not maxmin)
(minus beta)
(minus oldvcp)))
(restit)
(if (le valcp oldvcp) nil
(setq oldvcp valcp)
(if (ge valcp beta) (out (incr abcount))
(if first (setq meilleurcoup mind
coumpt cptcoups
meili i meilj j))))))
(setq valcp (times -1 oldvcp)
noeuds (plus cptcoups noeuds)
mind (pop)
j (pop)
i (pop)
limit (pop)
cptcoups (pop)
pt2 (pop)
1cl2 (pop)
1cl1 (pop)
oldvcp (pop)
lcp (pop) ))))
;Evaluation d'une position: fonctions EVALUE et EVCL.;
(de evalue (evcl)
(incr evaluat)
(if gagne
(if first (progn (setq gagne nil
pgagn nil
meili i
meilj j
meilleurcoup mind)
(out))
(setq gagne nil
pgagn nil)
10000)
(if maxmin (differ (times 3 (evcl cl1))(times 2 (evcl cl2)))
(differ (times 3 (evcl cl2))(times 2 (evcl cl1))))))
(de evcl (cl)
(setq xx 4 sum 0)
(repeat 4 (setq ccl (nextl cl)
sum (plus (times xx (nextl ccl)(length ccl))
sum))
(decr xx))
sum)
;Generation et tri des coups plausibles;
(de suivant ()
(if pt2 (nextl pt2)
(nextl lcp)
(setq pt2 (cdar lcp))
(nextl pt2)) )
(de cpsplaus (liste)
(setq gdpd (max (caar 1cl1) (caar 1cl2))
c22 0
lastpd 100)
(escape off
(while t
(setq 1cl (if (gt (caar 1cl1) (caar 1cl2))
(progn (setq %k nil) 1cl1)
(setq %k t)
1cl2)
pd (caar 1cl)
1erpd (cdar 1cl))
(while (car 1erpd)
(setq adr (nextl 1erpd)
autrpd (if %k (car (ta adr))
(cdr (ta adr))))
(if (ge autrpd lastpd) nil
(setq pd1 (plus pd (if %k (car (ta adr))
(cdr (ta adr))))
lis (assq pd1 liste))
(if lis (attach adr (cdr lis))
(inserer liste))))
(setq lastpd (caar 1cl))
(if %k (nextl 1cl2) (nextl 1cl1))
(incr c22)
(if (or (gt c22 5)(gt (differ gdpd lastpd) 5))
(off)) ))
liste)
(de inserer (l)
(escape out
(while l
(if (le pd1 (caar l)) (nextl l)
(attach (cons pd1 (cons adr)) l)
(out)))
(setq liste (nconc1 liste (cons pd1 (cons adr))))))
;TOP-LEVEL: fonctions JOUER, JEU1 et JEU2.
Utilitaires: fonctions ***, R, et RR.
Initialisation: fonctions JOUER et REINIT.;
(de jouer ()
(reinit)
(setq coumpt 1)
(mapc '(gagne pgagn coupforce lcp pereoldvcp 1cl1 1cl2 pt1 pt2 cptcoups
statistiques deja lcpforce limit go-b tsm2 tsm3 1er i j mind 1er maxmin) 'set)
(setq lcoups (cons 'coupsjoues:))
(printab)
(print "voulez-vous une position initiale ?")
(if (neq (read) 'oui) nil
(print "commencez par vos pions et finissez par nil")
(execoup)
(setq lcpforce nil coupforce nil)
(print "les pions machine")
(setq maxmin t)
(execoup))
(print "profondeur:")
(setq depth (sub1 (read)))
(if (ircamp) nil
(print "voulez-vous le go-bang imprime a chaque fois ?")
(if (eq (read) 'oui) (setq go-b t))
(print "statistiques ?")
(setq statistiques (if (eq (read) 'oui) t)))
(print "voulez-vous commencer ?")
(if (eq (read) 'oui) (jeu1)
(if (nerop (caar cl2)) (jeu2)
(setq i 10 j 10 mind 220)
(setq maxmin t)
(nconc1 (nconc1 lcoups (differ 20 i)) j)
(coup)
(if (ircamp) (outxys 12 31 "*") (print (differ 20 i) j))
(jeu1))))
(setq 1er nil)
;Coup de l'adversaire: fonction JEU1.;
(de jeu1 ()
(and go-b (printab))
(ifn (ircamp) (print "a vous"))
(while (not (numbp (setq i (read))))
(selectq i
(g (printab))
(r (r))
(rr (rr))
((eval i))))
(setq i (differ 20 i)
j (read)
mind (plus (times 21 j) i))
(if (ircamp) (outxys (differ 22 j) (add1 (times 3 (differ 20 i))) 'O))
(if (or (gt mind 418)(lt mind 22))
(progn (print "illegal") (jeu1))
(setq maxmin nil)
(if (not (numbp (car (ta mind))))
(progn (print 'illegal) (jeu1))
(nconc1 lcoups (list (differ 20 i) j))
(if lcpforce
(if (or (eq mind mind1)(eq mind mind2))
(setq tsm2 nil tsm3 nil)
(if (eq lcpforce 3)
(if (eq mind mind3)
(setq tsm2 nil tsm3 nil)
(setq sm1 mind1 sm2 mind2 sm3 mind3 tsm3 t))
(setq sm1 mind1 sm2 mind2 tsm2 t))))
(setq lcpforce nil)
(if coupforce
(if (eq coupforce mind)
(progn (setq coupforce nil)
(coup)
(if gagne (print '(vous gagnez))
(jeu2)))
(setq wi cpfi
wj cpfj
wm coupforce
coupforce nil)
(coup)
(if pgagn (print '(vous gagnez))
(setq i wi j wj mind wm maxmin t)
(coup)
(print '(je joue:) (differ 20 i) j '(et je gagne))))
(coup)
(if gagne (print '(vous gagnez))
(jeu2))))))
(da 'tabl (times 21 21))
(da 'tab2 (times 21 21))
(da 'ta 441)
(de reinit ()
(setq cl1 '((2 220 nil)(0 0 nil)) cl2 '((0 0 nil)))
(setqa tabl 220 (cdar cl1))
(maparray 'tabl '(lambda (x)))
(maparray 'tab2 '(lambda (x)))
(maparray 'ta '(lambda (x)
(if (zerop x) (setqa ta 0 '(# . #))
(setqa ta x
(if (or (le x 21)(gt x 420)
(zerop (rem x 21))(zerop (rem (add1 x) 21)))
(cons '# '#) (cons 0 0)))))))
(setq nn 8)
;Coup de la machine: fonction JEU2.;
(de jeu2 ()
(setq tempsmis (status 36))
(setq coumpt 1 abcount 0 noeuds 0 evaluat 0)
(***)
(if (gezp depth)
(search depth t -30000 30000 t)
(setq meilleurcoup (cadar (if (gt (caar cl1)(caar cl2)) cl1 cl2))
meili (rem meilleurcoup 21)
meilj (quo meilleurcoup 21)))
(ifn statistiques nil
(print noeuds "noeuds explores")
(print evaluat "evaluations de positions")
(print abcount "coupures alpha-beta")
(print "c'est le" coumpt (if (eq coumpt 1) "ier" "ieme")
"coup teste qui a ete choisi"))
(setq i meili
j meilj
mind meilleurcoup
maxmin t)
(if (ircamp) (outxys (differ 22 j) (add1 (times 3 (differ 20 i))) '*)
(print '(je joue:))
(print (differ 20 i) j))
(nconc1 (nconc1 lcoups (differ 20 i)) j)
(coup)
(setq lcpforce nil)
(ifn (ircamp)
(print 'temps 'mis: (differ (status 36) tempsmis) 'ms))
(if gagne (print '(je gagne)) (jeu1))))
(de *** ()
(if tsm2 (setq lcpforce 2 mind1 sm1 mind2 sm2)
(if tsm3
(setq lcpforce 3 mind1 sm1 mind2 sm2 mind3 sm3))))
(de r () (rr) (printab))
(de rr () (restit) (setq maxmin (not maxmin)))
(de execoup ()
(while (setq i (read))
(setq i (differ 20 i)
j (read)
mind (plus (times 21 j) i))
(coup))
(setq gagne nil pgagn nil))
;Algorithme de ponderation de GO-BANG.;
(de -ligne (i j di dj)
(while lni
(setq ni (nextl lni))
(setq n1 (max (differ 0 n2)
(differ ni 4)))
(setq n (differ pn1 n1))
(1ligne i j)))
(de -2lignes (di dj)
(setq lni (demil i j di dj)
pn1 n1)
(setq lni2 (demil i j (times di -1)(times dj -1))
n2 n1)
(-ligne i j di dj)
(setq lni lni2
lni2 pn1
pn1 n2
n2 lni2)
(-ligne i j (times di -1)(times dj -1)))
(de star (pion cl tab sig)
(cond (sig (-2lignes -1 1)
(-2lignes 0 1)
(-2lignes 1 1)
(-2lignes 1 0))
(t (ligne -1 1)
(ligne 0 1)
(ligne 1 1)
(ligne 1 0))))
(de 1ligne (i j)
(if sig (setq i (plus i (times di n1))
j (plus j (times dj n1)))
(setq i (differ i (times di n1))
j (differ j (times dj n1))))
(setq x 1)
(setq b (differ n 4))
(poids 1)
(repeat (differ 9 n) (chgpd))
(setq x (sub1 x))
(poids -1))
(de ligne (di dj)
(setq tst nil)
(demil i j di dj)
(setq pn1 n1
tem milieu
extlib1 extlib
rextr1 extr)
(demil i j (times di -1)(times dj -1))
(cond (tem (lmil extr rextr1 extlib tem di dj))
(milieu (lmil rextr1 extr extlib1 milieu (times di -1)(times dj -1)))
(t (selectq (plus extr rextr1)
(4 (if (and extlib extlib1)
(if lcpforce (setq gagne t pgagn t)
(setq mind1 (plus (times 21
(differ j (times dj extr)))
(differ i (times di extr)))
mind2 (plus (times 21
(plus j (times dj rextr1)))
(plus i (times di rextr1)))
lcpforce
(if (numbp (car (ta
(setq mind3 (plus (times 21
(plus j (times dj (add1 rextr1))))
(plus i (times di (add1 rextr1))))))))
(if (numbp (car (ta (plus (times 21
(differ j (times dj
(add1 extr))))
(differ i (times di
(add1 extr)))))))
2
3)
(if (numbp (car (ta
(setq mind3 (plus (times 21
(differ j (times dj (add1 extr))))
(differ i (times di (add1 extr))))))))
3))))))
(5 (if extlib
(if extlib1 (setq gagne t pgagn t)
(coupforce extr t))
(if extlib1 (coupforce rextr1))))
(6 (setq gagne t))
())))
(setq n (plus n1 pn1))
(if (gt n 3) (1ligne i j)))
(de poids (dx)
(repeat b (chgpd) (setq x (plus x dx))))
(de demil (i j di dj lni)
(setq n1 0 c01 0 extr 1 milieu nil tx t)
(while t
(setq i (plus i di) j (plus j dj)
caid (ta (plus (times 21 j) i))
case (if sig
(if maxmin (cdr caid) (car caid))
(if maxmin (car caid) (cdr caid))))
(cond ((or (eq case pion)(eq case '#))
(setq extlib (neq n1 c01)
extr (add1 c01))
(lescape lni))
((eq n1 4)
(setq extlib t
extr (add1 c01))
(lescape lni)))
(setq n1 (add1 n1))
(if (numbp case) nil
(if sig (setq lni (nconc1 lni n1))
(if tx
(selectq (differ n1 c01)
(1 (incr c01))
(2 (if tst (setq tx nil)
(incr c01)
(setq milieu c01)
(incr c01)
(setq tst t)))
((setq tx nil))))))
)))
(de chgpd ()
(setq tb (plus (times 21 j) i))
(setq case (ta tb))
(if (numbp (car case))
(if sig
(if maxmin
(progn (setq k (cdr case))
(push tb k)
(ote)
(rplacd case (setq k (differ k x)))
(range k cl))
(setq k (car case))
(push tb k)
(ote)
(rplaca case (setq k (differ k x)))
(range k cl))
(if maxmin
(progn (setq k (car case))
(push tb k)
(ote)
(rplaca case (setq k (plus k x)))
(range k cl))
(setq k (cdr case))
(push tb k)
(ote)
(rplacd case (setq k (plus k x)))
(range k cl))))
(setq i (plus i di) j (plus j dj)))
(de coup ()
(setq case (ta mind)
coupforce nil)
(push (car case) (cdr case) mind '##)
(setq tb mind)
(setq tab 'tabl)
(ote)
(setq tab 'tab2)
(ote)
(cond (maxmin (setq part '+
adv '-
c1 cl1 c2 cl2
t1 'tabl t2 'tab2)
(rplaca case '+)(rplacd case '+))
(t (setq part '- adv '+
c1 cl2 c2 cl1
t1 'tab2 t2 'tabl)
(rplaca case '-)(rplacd case '-)))
(star adv c1 t1)
(push '#)
(star part c2 t2 t))
(de lmil (extr extrm extlib milieu di dj)
(selectq (plus extr milieu)
(5 (if extlib (setq gagne t pgagn t)
(coupforce milieu)))
(6 (setq gagne t))
((if (ge (plus extr extrm) 6) (coupforce milieu)))))
(de coupforce (x sig)
(if sig (setq cpfi (differ i (times di x))
cpfj (differ j (times dj x)))
(setq cpfi (plus i (times di x))
cpfj (plus j (times dj x))))
(setq cpfaid (plus (times 21 cpfj) cpfi))
(if coupforce
(if (eq coupforce cpfaid) nil
(setq gagne t pgagn t))
(setq coupforce cpfaid)))
;Impression du GO-BANG.(representations externes et internes).;
(de printab (f m k)
(setq k 20)
(setq m (reverse (listarray 'ta)))
(while m
(while (eq (caar m) '#) (nextl m))
(setq k (sub1 k)) (if (ircamp) (outxys (differ 22 k) 1 k) (prin1 k))
(or (ircamp) (and (lt k 10) (spaces 1)))
(setq derc nil col 1)
(and m
(while (neq (caar m) '#)
(if (ircamp) (setq col (plus 3 col))
(if derc (setq derc nil) (spaces 1)))
(if f
(if (not (numbp (caar m)))
(if (ircamp)
(outxys (differ 22 k)
col (if (eq (caar m) '+) "+" "-"))
(prin1 (car (nextl m))))
(if (ircamp) (outxys (differ 22 k) col (f (nextl m)))
(if (gt (prin1 (f (nextl m))) 9)
(setq derc t))) )
(if (ircamp) (outxys (differ 22 k) col
(if (numbp (caar m)) "."
(if (eq (caar m) '+) "*" "O")))
(prin1 (if (numbp (caar m)) '/.
(if (eq (caar m) '+) '* 'o))))
(nextl m))))
(or (ircamp) (terpri)))
(setq col 1)
(while (lt k 20)
(setq col (plus 3 col))
(if (ircamp) (if (le k 18) (outxys 22 col (add1 k)))
(if (lt k 10) (spaces 1))(prin1 k))
(setq k (add1 k)))(or (ircamp) (terpri)))
(de pcd ()
(printab '(lambda (s) (plus (car s) (cdr s)))))
(de outxys (x y s)
(upgiot ()
(append [\177 \14 (logxor \140 y)(logxor \140 x)]
(mapcar (maklist s) 'cascii))))
(setq lcpforce nil)
(da 'breadth 6)
(fillarray 'breadth '(3 3 4 5 5 5))
(de pa () (printab 'car)) (de pd () (printab 'cdr))
(de play (i j maxmin)
(setq i (differ 20 i)
mind (plus (times 21 j) i))
(coup))
(setq coupforce nil gagne nil)
(setq maxmin)
(de excoup (i j)
(coup i j maxmin))
;Restitution de l'etat precedant un coup joue.
fonctions RESTIT et RESTAID.;
(de restit ()
(setq gagne nil pgagn nil coupforce nil lcpforce nil)
(cond (maxmin
(restaid '# 'tab2 cl2)
(restaid '## 'tabl cl1))
(t
(restaid '# 'tabl cl1)
(restaid '## 'tab2 cl2)))
(setq tb (pop) tab 'tab2)
(range (setq k (pop)) cl2)
(rplacd (ta tb) k)
(setq tab 'tabl)
(range (setq k (pop)) cl1)
(rplaca (ta tb) k))
(de restaid (s tab cl)
(while (neq (setq k (pop)) s)
(setq tb (pop))
(if (eq tab 'tabl) (rplaca (ta tb) k)
(rplacd (ta tb) k))
(ote)
(range k cl)))
;Insertion d'une intersection ponderee dans une des deux tables
(fonction RANGE) et extraction d'une intersection ponderee
d'une des deux tables (fonction OTE).;
(de range (x cl)
(repeat (if (zerop x) 0 nn)
(if (null (cadar cl)) (smash cl))
(setq z (caar cl))
(cond ((gt x z)
(attach (cons x (cons tb (cons ))) cl)
(lescape (seta tab tb (cdar cl))))
((eq x z)
(lescape (seta tab tb (cdr (rplacd (car cl)
(cons tb (cdar cl)))))))
) (nextl cl)))
(de ote ()
(cond ((setq m (tab tb ))
(rplaca m (setq free (cadr m)))
(rplacd m (cddr m))
(if (numbp free) (seta tab free m))
(seta tab tb ))))
;(de evcl (cl)
(setq sum 0)
(if evcl
(progn (while (gt (caar cl) evcl)
(setq ccl (nextl cl)
sum (plus (times (nextl ccl) (length (cdr ccl)))
sum)))
sum)
(repeat 4 (setq ccl (nextl cl)
sum (plus (times (nextl ccl) (length (cdr ccl))) sum)))
(setq evcl (or (caar cl) 0))
sum));